home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / banner.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-03-15  |  2.0 KB  |  65 lines
  1. program banner;
  2.  
  3. var
  4.   p: array[0..7,0..7] of boolean;
  5.   b: byte;
  6.   i,j,k,n,an,x: integer;
  7.   pchr,size,ch,c: char;
  8.   aa: string[72];
  9.   istr: string[80];
  10.  
  11. begin
  12.   clrscr;
  13.   writeln('Enter the character to be used in printing the banner');
  14.   write('(for example "X") or press return to use the entered character:  ');
  15.   read(kbd,pchr); writeln(pchr);
  16.   writeln;
  17.   write('Enter the banner size  1) 24 chars wide, 2) 48 chars wide, 3) 72 chars wide:  ');
  18.   repeat read(kbd,size) until size in ['1'..'3']; writeln(size);
  19.   n:=ord(size)-ord('0');
  20.   writeln;
  21.   writeln;
  22.   writeln('Press any key when printer is ready');
  23.   read(kbd,ch);
  24.   writeln;
  25.   writeln;
  26.   writeln('Begin typing your banner (press return to end the line).');
  27.   writeln;
  28.   readln(istr);
  29.   for x:=1 to length(istr) do
  30.   begin
  31.     ch:=istr[x];
  32.     if ch in [' '..'~'] then
  33.     begin
  34.       if pchr=^M then c:=ch else c:=pchr;
  35.       aa:='';
  36.       for i:=1 to 3*n do aa:=aa+c;
  37.       an:=$FA6D+8*ord(ch);
  38.       for i:=0 to 7 do
  39.       begin
  40.         b:=mem[$F000:an+i];
  41.         if (b and $80)=$80 then p[i,7]:=true else p[i,7]:=false;
  42.         if (b and $40)=$40 then p[i,6]:=true else p[i,6]:=false;
  43.         if (b and $20)=$20 then p[i,5]:=true else p[i,5]:=false;
  44.         if (b and $10)=$10 then p[i,4]:=true else p[i,4]:=false;
  45.         if (b and $08)=$08 then p[i,3]:=true else p[i,3]:=false;
  46.         if (b and $04)=$04 then p[i,2]:=true else p[i,2]:=false;
  47.         if (b and $02)=$02 then p[i,1]:=true else p[i,1]:=false;
  48.         if (b and $01)=$01 then p[i,0]:=true else p[i,0]:=false;
  49.       end;
  50.       for i:=7 downto 0 do
  51.         for j:=1 to n do
  52.         begin
  53.           write(lst,'':12*(3-n));
  54.           for k:=7 downto 0 do
  55.             if p[k,i] then write(lst,aa) else write(lst,'':3*n);
  56.           writeln(lst);
  57.         end;
  58.       writeln(lst);
  59.     end;
  60.   end;
  61.   if istr<>'' then write(lst,^L);
  62.   writeln;
  63.   writeln('End of BANNER program');
  64. end.
  65.